home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pasmou.zip / MOUSE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-14  |  4KB  |  140 lines
  1. (* 'True' mouse cursor for EGA/VGA displays using C functions written
  2.     by Dave Kirsch.   Turbo Pascal unit by Jim Loos. *)
  3.  
  4. unit mouse;
  5. interface
  6. const
  7.    (* Bit defines for mouse driver function 12 -- define handler. *)
  8.    MOUSEMOVE     = 1;
  9.    LEFTBPRESS    = 2;
  10.    LEFTBRELEASE  = 4;
  11.    RIGHTBPRESS   = 8;
  12.    RIGHTBRELEASE = 16;
  13.  
  14.    LEFTBDOWN  = 1;
  15.    RIGHTBDOWN = 2;
  16.  
  17.    (* Shift states for byte a 0:417h
  18.       bit 7 =1 INSert active
  19.       bit 6 =1 Caps Lock active
  20.       bit 5 =1 Num Lock active
  21.       bit 4 =1 Scroll Lock active
  22.       bit 3 =1 either Alt pressed
  23.       bit 2 =1 either Ctrl pressed
  24.       bit 1 =1 Left Shift pressed
  25.       bit 0 =1 Right Shift pressed
  26.    *)
  27.  
  28.    SHIFT_RIGHTSHIFT = $01;
  29.    SHIFT_LEFTSHIFT  = $02;
  30.    SHIFT_SHIFT      = $03;   (* Either shift key. *)
  31.    SHIFT_CTRL       = $04;
  32.    SHIFT_ALT        = $08;
  33.    SHIFT_SCROLLLOCK = $10;
  34.    SHIFT_NUMLOCK    = $20;
  35.    SHIFT_CAPSLOCK   = $40;
  36.    SHIFT_INS        = $80;
  37.  
  38. mouseinstalled: word = 0;    (* zero means that the driver is not installed *)
  39. mousehidden: word = 0;       (* non-zero means that the mouse is hidden *)
  40. mousex: integer = 0;         (* mouse cursor X coordinate; updated by driver *)
  41. mousey: integer = 0;         (* mouse cursor Y coordinate: updated by driver *)
  42.  
  43. type
  44. (* Mouse information record *)
  45. mouinforec = record
  46.   buttonstat: word;          (* status of mouse buttons (see above) *)
  47.   cx, cy: integer;           (* mouse cursor X and Y coordinates *)
  48.   shiftstate: byte;          (* status of shift, control, and alt keys *)
  49. end;
  50.  
  51. mouinforecptr = ^mouinforec;
  52.  
  53. var
  54. M: mouinforecptr;
  55. Minfo: mouinforec;
  56.  
  57. (* Initialize the mouse routines -- must be called. *)
  58. procedure MOUinit; 
  59.  
  60. (* Deinitialize the mouse routines -- must be called on shutdown.
  61.    Failure to call it will most likely result in a system crash if the mouse
  62.    is moved. *)
  63. procedure MOUdeinit;
  64.  
  65. (* Hide the mouse cursor *)
  66. procedure MOUhide; 
  67.  
  68. (* Hide the mouse cursor if it moves or is in a specific rectangular region
  69.    of the screen. *)
  70. procedure MOUconditionalhide(x1, y1, x2, y2: integer); 
  71.  
  72. (* Show the mouse cursor *)
  73. procedure MOUshow; 
  74.  
  75. (* return TRUE if there are events waiting in the buffer. *)
  76. function MOUcheck: boolean; 
  77.  
  78. (* look at the next event in the buffer, but don't pull it out. *)
  79. procedure MOUpreview(MP: mouinforecptr); 
  80.  
  81. (* get and remove next event from the buffer. *)
  82. procedure MOUget(MP: mouinforecptr); 
  83.  
  84. (* return the current status of the mouse buttons (see defines above). *)
  85. function MOUbuttonstatus: word;
  86.  
  87. (* move mouse cursor to new position *)
  88. procedure MOUmove(X, Y: integer);
  89.  
  90. (* confine mouse to region of screen *)
  91. procedure MOUconfine(X1, Y1, X2, Y2: integer);
  92.  
  93. implementation
  94. uses CRT, DOS;
  95. {$L MOUSE.OBJ}
  96.  
  97. var Points: byte absolute $0000:$0485;
  98.  
  99. procedure MOUinit; external;
  100. procedure MOUdeinit; external;
  101. procedure MOUhide; external;
  102. procedure MOUconditionalhide(x1, y1, x2, y2: integer); external;
  103. procedure MOUshow; external;
  104. function MOUcheck: boolean; external;
  105. procedure MOUpreview(MP: mouinforecptr); external;
  106. procedure MOUget(MP: mouinforecptr); external;
  107. function MOUbuttonstatus: word; external;
  108.  
  109. procedure MOUmove(X, Y: integer);
  110. var
  111.   Reg: registers;
  112. begin
  113.    MOUHide;
  114.    mousex := X;
  115.    mousey := Y;
  116.    Reg.CX := pred(X*8);
  117.    Reg.DX := Y * Points;
  118.    Reg.AX := 4;
  119.    intr($33, Reg);
  120.    MOUshow;
  121. end; {procedure MOUmove}
  122.  
  123. procedure MOUconfine(X1, Y1, X2, Y2: integer);
  124. var Reg: registers;
  125. begin
  126.     Reg.AX := 7;
  127.     Reg.CX := X1 * 8;
  128.     Reg.DX := X2 * 8;
  129.     intr($33, Reg);               (* set horizontal limit *)
  130.     Reg.AX := 8;
  131.     Reg.CX := Y1 * Points;
  132.     Reg.DX := Y2 * Points;
  133.     intr($33, Reg);               (* set vertical limit *)
  134. end;
  135.  
  136. begin
  137.    M := @Minfo;
  138. end.
  139.  
  140.